Cluster Trends
Janette Avelar
2024-03-07
# start by creating cluster subsets
#subset values
deeper <- cluster %>%
filter(proposed_cluster_for_preliminary_24_analysis == "Deeper learning") %>%
select(label = tag) %>%
left_join(labels, by = "label") %>%
pull(var)
ed_justice <- cluster %>%
filter(proposed_cluster_for_preliminary_24_analysis == "Ed justice") %>%
select(label = tag) %>%
left_join(labels, by = "label") %>%
pull(var)
individualized <- cluster %>%
filter(proposed_cluster_for_preliminary_24_analysis == "Individualized") %>%
select(label = tag) %>%
left_join(labels, by = "label") %>%
pull(var)
postsecondary <- cluster %>%
filter(proposed_cluster_for_preliminary_24_analysis == "Postsecondary") %>%
select(label = tag) %>%
left_join(labels, by = "label") %>%
pull(var)
none <- cluster %>%
filter(proposed_cluster_for_preliminary_24_analysis == "None" |
proposed_cluster_for_preliminary_24_analysis == "None?") %>%
select(label = tag) %>%
left_join(labels, by = "label") %>%
pull(var)Deeper Learning Cluster
Tags:
- assessments for deeper learning
- competency/mastery-based education
- competency framework
- design thinking process
- interdisciplinary
- makerspace
- multiple opportunities to demonstrate mastery
- project-based learning
- performance based assessment
- place-based learning
- student-led conferences
- students develop projects
Guiding question: How have the rates of deeper learning tags changed each year since 2019?
#set up repeating schools
repeaters <- dat %>%
select(school_id, year) %>%
unique() %>%
mutate(rate = 1) %>%
pivot_wider(names_from = "year",
values_from = "rate") %>%
rowwise() %>%
mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>%
filter(participate > 1) %>%
pull(school_id)
#set up totals
tots <- dat %>%
group_by(year) %>%
summarize(total = n_distinct(school_id)) %>%
unique()
#prep data function across schools
prep_across <- function(data, cluster){
dat <- data %>%
filter(var %in% cluster) %>%
group_by(var, year) %>%
summarize(n = sum(usage)) %>%
ungroup() %>%
left_join(tots, by = "year") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var") %>%
group_by(var) %>%
mutate(x_coord = max(year),
y_coord = pct[which.max(year)])
return(dat)
}
#prep data function within schools
prep_within <- function(data, cluster){
dat <- data %>%
filter(var %in% cluster) %>%
filter(school_id %in% repeaters) %>%
arrange(school_id, year) %>%
group_by(school_id) %>%
mutate(wave = dense_rank(year)) %>%
ungroup() %>%
arrange(school_id, year) %>%
group_by(school_id, var) %>%
mutate(change = usage - lag(usage)) %>%
ungroup() %>%
mutate(adds = ifelse(change == 1, 1, NA),
drops = ifelse(change == -1, 1, NA)) %>%
group_by(var, year) %>%
summarize(`Overall rate` = sum(usage, na.rm = TRUE),
`Average change` = sum(change, na.rm = TRUE),
Adds = sum(adds, na.rm = TRUE),
Drops = sum(drops, na.rm = TRUE)) %>%
ungroup() %>%
pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
names_to = "type",
values_to = "n") %>%
left_join(labels, by = "var") %>%
mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops"))) %>%
#3.27.24 modification = remove 2019 & only present adds/drops
filter(year > 2019, type == "Adds" | type == "Drops")
return(dat)
}
#prep data function overall pct
prep_overall <- function(data, cluster){
dat <- data %>%
filter(var %in% cluster) %>%
filter(school_id %in% repeaters) %>%
group_by(var, year) %>%
summarize(n = sum(usage, na.rm = TRUE)) %>%
ungroup() %>%
left_join(tots, by = "year") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var") %>%
group_by(var) %>%
mutate(x_coord = max(year),
y_coord = pct[which.max(year)])
return(dat)
}
#plot function for across schools
cluster_plot_across <- function(data, x, y, labels) {
#palette <- c("#BC2582", "#FFA630", "#FFDE42", "#99C24D", "#218380", "#D3B7D7")
labels <- data %>%
select(label, x_coord, y_coord) %>%
unique()
plot <- ggplot(data, aes_string(x = x, y = y, color = "label")) +
geom_point() +
geom_line() +
theme_bw() +
scale_x_continuous(limits = c(2019, 2026),
expand = c(0.01, 0),
breaks = unique(data$year)) + #expand 0.025, .3
scale_y_continuous(limits = c(0, 1),
expand = c(0, 0),
labels = scales::percent_format(accuracy = 1)) +
theme(legend.position = "none") +
geom_text_repel(data = labels,
aes_string(label = str_wrap("label", 10), x = "x_coord", y = "y_coord")
#position = position_jitterdodge(dodge.width = 0.5, jitter.height = 0.025),
#hjust = -.05,
#vjust = 0.5
)
return(plot)
}
#plot function for within schools
# cluster_plot_within <- function(data, x, y, labels){
#
# plot <- ggplot(data, aes_string(x = x, y = y, group = type)) +
# geom_point() +
# geom_line(aes_string(group = type), color = "gray") +
# geom_smooth(method = "lm", formula = y ~ x, se = FALSE, color = "blue", aes(group = 1)) +
# theme_bw() +
# scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
# theme(panel.grid.major.x = element_blank(),
# panel.grid.minor.x = element_blank(),
# legend.position = "none") +
# facet_wrap(~type) +
# labs(x = "Year",
# y = "Tag selection (N)") +
# scale_color_identity()
#
# return(plot)
# }
cluster_plot_within <- function(data, x, y, facet, group) {
plot <- ggplot(data, aes_string(x = x, y = y)) +
geom_line(aes(group = group), color = "gray", alpha = 0.5) +
geom_point(aes(group = group), color = "gray", alpha = 0.5, size = 1) +
geom_smooth(se = FALSE, color = "cornflowerblue", aes(group = 1)) +
#straight line before
#geom_smooth(method = "lm", se = FALSE, color = "blue", aes(group = 1)) +
theme_bw() +
scale_x_continuous(name = x, expand = expansion(mult = c(.025, .3))) +
theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), legend.position = "none") +
facet_wrap(as.formula(paste0("~", facet)), scales = "free_y") +
labs(x = x, y = y)
return(plot)
}Across schools
deep <- prep_across(dat, deeper)
cluster_plot_across(deep, "year", "pct", labels)## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Within schools
Overall rate among repeat schools:
deep <- prep_overall(dat, deeper)
cluster_plot_across(deep, "year", "pct", labels)
deep <- prep_within(dat, deeper)
cluster_plot_within(deep, deep$year, deep$n, "type", deep$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 3.8706e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 3.8706e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602
Educational Justice Cluster
Tags:
- adult wellness/SEL
- anti-racist practices
- assessments for social-emotional skills
- teachers as co-leaders
- co-leadership
- family and community support services
- culturally responsive practices
- design to meet needs of students who have been marginalized
- hiring for equity and inclusion values
- all courses designed for inclusion
- mental health services
- physical well being services
- reallocation of resources for those most in need
- restorative practices
- SEL curriculum
- SEL integration school-wide
- social justice focus
- translanguaging
- trauma-informed practices
Across schools
justice_dat <- prep_across(dat, ed_justice)
cluster_plot_across(justice_dat, "year", "pct", labels)
Within schools
Overall rate among repeat schools:
justice_dat <- prep_overall(dat, ed_justice)
cluster_plot_across(justice_dat, "year", "pct", labels)
justice_dat <- prep_within(dat, ed_justice)
cluster_plot_within(justice_dat, justice_dat$year, justice_dat$n, "type", justice_dat$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.5233e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.5233e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1
Individualized Cluster
Tags:
- accommodations provided to all students
- blended learning
- flex model
- flipped classroom
- interoperable data from multiple technologies
- 1:1 mentoring
- station rotation
- students access their own data
- self-paced learning
Across schools
ind_dat <- prep_across(dat, individualized)
cluster_plot_across(ind_dat, "year", "pct", labels)
Within schools
Overall rate among repeat schools:
ind_dat <- prep_overall(dat, individualized)
cluster_plot_across(ind_dat, "year", "pct", labels)
ind_dat <- prep_within(dat, individualized)
cluster_plot_within(ind_dat, ind_dat$year, ind_dat$n, "type", ind_dat$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.247e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.247e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602
Postsecondary Cluster
Tags:
- à la carte model
- assessments for career readiness
- career prep and work-based learning
- community-based organizations as co-leaders
- industry-based partners as co-leaders
- community and business partnerships
- early college high school
- extended learning opportunities
- students earn industry credentials
Across schools
post_dat <- prep_across(dat, postsecondary)
cluster_plot_across(post_dat, "year", "pct", labels)
Within schools
Overall rate among repeat schools:
post_dat <- prep_overall(dat, postsecondary)
cluster_plot_across(post_dat, "year", "pct", labels)
post_dat <- prep_within(dat, postsecondary)
cluster_plot_within(post_dat, post_dat$year, post_dat$n, "type", post_dat$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 9.792e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 9.792e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1
High Schools only - Across
# set up data prep
# ID high schools
hs <- import(here("data/longitudinal", "longitudinal_data.csv")) %>%
select(school_id, grades_high) %>%
filter(grades_high == 1) %>%
pull(school_id)
#set up repeating schools
hs_repeaters <- dat %>%
filter(school_id %in% hs) %>%
select(school_id, year) %>%
unique() %>%
mutate(rate = 1) %>%
pivot_wider(names_from = "year",
values_from = "rate") %>%
rowwise() %>%
mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, `2024`, na.rm = TRUE)) %>%
filter(participate > 1) %>%
pull(school_id)
#set up totals
hs_tots <- dat %>%
filter(school_id %in% hs) %>%
group_by(year) %>%
summarize(total = n_distinct(school_id)) %>%
unique()
#prep data across schools
hs_across <- dat %>%
filter(school_id %in% hs) %>%
filter(var %in% postsecondary) %>%
group_by(var, year) %>%
summarize(n = sum(usage)) %>%
ungroup() %>%
left_join(hs_tots, by = "year", relationship = "many-to-many") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var") %>%
group_by(var) %>%
mutate(x_coord = max(year),
y_coord = pct[which.max(year)])
#prep data within schools
hs_within <- dat %>%
filter(school_id %in% hs) %>%
filter(var %in% postsecondary) %>%
filter(school_id %in% hs_repeaters) %>%
arrange(school_id, year) %>%
group_by(school_id) %>%
mutate(wave = dense_rank(year)) %>%
ungroup() %>%
arrange(school_id, year) %>%
group_by(school_id, var) %>%
mutate(change = usage - lag(usage)) %>%
ungroup() %>%
mutate(adds = ifelse(change == 1, 1, NA),
drops = ifelse(change == -1, 1, NA)) %>%
group_by(var, year) %>%
summarize(`Overall rate` = sum(usage, na.rm = TRUE),
`Average change` = sum(change, na.rm = TRUE),
Adds = sum(adds, na.rm = TRUE),
Drops = sum(drops, na.rm = TRUE)) %>%
ungroup() %>%
pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
names_to = "type",
values_to = "n") %>%
left_join(labels, by = "var") %>%
mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops"))) %>%
#3.27.24 modification = remove 2019 & only present adds/drops
filter(year > 2019, type == "Adds" | type == "Drops")
#prep data overall pct
hs_overall <- dat %>%
filter(var %in% postsecondary) %>%
filter(school_id %in% hs_repeaters) %>%
group_by(var, year) %>%
summarize(n = sum(usage, na.rm = TRUE)) %>%
ungroup() %>%
left_join(hs_tots, by = "year") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var") %>%
group_by(var) %>%
mutate(x_coord = max(year),
y_coord = pct[which.max(year)])Across high schools
cluster_plot_across(hs_across, "year", "pct", labels)
Within high schools
Overall rate among repeat high schools:
cluster_plot_across(hs_overall, "year", "pct", labels)
cluster_plot_within(hs_within, hs_within$year, hs_within$n, "type", hs_within$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 9.792e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 9.792e-17## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1
None tags
Across schools
none_dat <- prep_across(dat, none)
cluster_plot_across(none_dat, "year", "pct", labels)
Within schools
Overall rate among repeat schools:
none_dat <- prep_overall(dat, none)
cluster_plot_across(none_dat, "year", "pct", labels)
none_dat <- prep_within(dat, none)
cluster_plot_within(none_dat, none_dat$year, none_dat$n, "type", none_dat$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.3094e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2024## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.3094e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 1
Blended Learning Cluster
Reminder: This cluster is separate from the analysis - this was a starting point.
Tags: - blended learning
- à la carte model
- flipped classroom
- flex model
- enriched virtual model
- station rotation
Across schools
# subset tags
blended_tags <- c("practices_blended_learning", "practices_a_la_carte", "practices_flipped_classroom", "practices_flex", "practices_enriched_virtual", "practices_station_rotation")
blend_dat <- prep_across(dat, blended_tags)
cluster_plot_across(blend_dat, "year", "pct", labels)
Within schools
Overall rate among repeat schools:
blend_dat <- prep_overall(dat, blended_tags)
cluster_plot_across(blend_dat, "year", "pct", labels)
blend_dat <- prep_within(dat, blended_tags)
cluster_plot_within(blend_dat, blend_dat$year, blend_dat$n, "type", blend_dat$label)## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.8155e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 2021## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.015## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 1.8155e-16## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602
============= FIRST VERSION GRAPHS =============== ### Across schools Graph #1 looks at selection of tags across our whole sample, i.e., the number reflects the percentage of our total sample of schools that selected each tag. (AKA across schools)
One of the questions we were hoping to investigate with this graph is
whether the selection of blended learning tags may be due to changes in
our survey design through the introduction of parent/child tags. We do
see a sharp decrease in child tags in 2023. However, the selection for
the parent tag blended learning remains high. All school
leaders that selected blended learning would have received
a follow-up question about the type of blended learning they use with
our child tags listed below. This makes me think that schools are still
using blended learning, but perhaps did not see their approach to
blended learning reflected in our child tags. (So what are they
using…?)
blended <- dat %>%
filter(var %in% blended_tags) %>%
group_by(var, year) %>%
summarize(n = sum(usage)) %>%
ungroup()
tots <- dat %>%
group_by(year) %>%
summarize(total = n_distinct(school_id)) %>%
unique()
blended <- blended %>%
left_join(tots, by = "year") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var")
#build plot
#palette colors
palette <- c("#BC2582", "#FFA630","#FFDE42","#99C24D","#218380","#D3B7D7")
#labels
labs <- blended %>%
filter(year == 2024) %>%
select(label, x = year, y = pct)
#plot
blended %>%
ggplot(aes(year, pct, color = label)) +
geom_point() +
geom_line() +
theme_bw() +
scale_color_manual(values = palette) +
scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(legend.position = "none") +
geom_text(data = labs,
aes(label = label,
x = x,
y = y),
hjust = -.05)
Across schools (no COVID)
What if we omit 2021 to account for the big jump?
blended <- dat %>%
filter(var %in% blended_tags) %>%
filter(year != 2021) %>%
group_by(var, year) %>%
summarize(n = sum(usage)) %>%
ungroup() %>%
left_join(tots, by = "year") %>%
mutate(pct = n/total) %>%
left_join(labels, by = "var")
#plot
blended %>%
ggplot(aes(year, pct, color = label)) +
geom_point() +
geom_line() +
theme_bw() +
scale_color_manual(values = palette) +
scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
theme(legend.position = "none") +
geom_text(data = labs,
aes(label = label,
x = x,
y = y),
hjust = -.05)
Within schools
Graph #2 looks at the rate of change for blended learning tags only among schools that participated for 2 or more years. (AKA within schools)
#key for participating schools 2+ times
repeaters <- dat %>%
select(school_id, year) %>%
unique() %>%
mutate(rate = 1) %>%
pivot_wider(names_from = "year",
values_from = "rate") %>%
rowwise() %>%
mutate(participate = sum(`2019`, `2021`, `2022`, `2023`, na.rm = TRUE)) %>%
filter(participate > 1) %>%
pull(school_id)
#data
blended <- dat %>%
#filter only blended tags
filter(var %in% blended_tags) %>%
#filter only repeat schools
filter(school_id %in% repeaters) %>%
#create wave variable
arrange(school_id, year) %>%
group_by(school_id) %>%
mutate(wave = dense_rank(year)) %>%
ungroup() %>%
#create change column
arrange(school_id, year) %>%
group_by(school_id, var) %>%
mutate(change = usage - lag(usage)) %>%
ungroup() %>%
#create add/drop columns
mutate(adds = ifelse(change == 1, 1, NA),
drops = ifelse(change == -1, 1, NA)) %>%
#create totals
group_by(var, year) %>%
summarize(`Overall rate` = sum(usage, na.rm = TRUE),
`Average change` = sum(change, na.rm = TRUE),
Adds = sum(adds, na.rm = TRUE),
Drops = sum(drops, na.rm = TRUE)) %>%
ungroup() %>%
#pivot for plotting
pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
names_to = "type",
values_to = "n") %>%
#labels for plotting
left_join(labels, by = "var") %>%
#order for plotting
mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops")))
#palette for plot
palette <- c("gray80", "#f1c1af", "#6bd497", "#b94c4c")
#plot
blended %>%
ggplot(aes(year, n, color = type)) +
geom_point() +
geom_line() +
theme_bw() +
scale_color_manual(values = palette) +
scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()) +
theme(legend.position = "bottom") +
facet_wrap(~label) +
labs(x = "Year",
y = "Tag selection (N)",
color = "Rate of change")
Within schools (no COVID)
Again, what if we omit 2021?
#data
blended <- dat %>%
#filter only blended tags
filter(var %in% blended_tags) %>%
#filter only repeat schools
filter(school_id %in% repeaters) %>%
#drop 2021 year
filter(year != 2021) %>%
#create wave variable
arrange(school_id, year) %>%
group_by(school_id) %>%
mutate(wave = dense_rank(year)) %>%
ungroup() %>%
#create change column
arrange(school_id, year) %>%
group_by(school_id, var) %>%
mutate(change = usage - lag(usage)) %>%
ungroup() %>%
#create add/drop columns
mutate(adds = ifelse(change == 1, 1, NA),
drops = ifelse(change == -1, 1, NA)) %>%
#create totals
group_by(var, year) %>%
summarize(`Overall rate` = sum(usage, na.rm = TRUE),
`Average change` = sum(change, na.rm = TRUE),
Adds = sum(adds, na.rm = TRUE),
Drops = sum(drops, na.rm = TRUE)) %>%
ungroup() %>%
#pivot for plotting
pivot_longer(cols = c(`Overall rate`, `Average change`, Adds, Drops),
names_to = "type",
values_to = "n") %>%
#labels for plotting
left_join(labels, by = "var") %>%
#order for plotting
mutate(type = factor(type, levels = c("Overall rate", "Average change", "Adds", "Drops")))
#plot
blended %>%
ggplot(aes(year, n, color = type)) +
geom_point() +
geom_line() +
theme_bw() +
scale_color_manual(values = palette) +
scale_x_continuous(expand = expansion(mult = c(.025, .3))) +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()) +
theme(legend.position = "bottom") +
facet_wrap(~label) +
labs(x = "Year",
y = "Tag selection (N)",
color = "Rate of change")
2023 Drop Investigation
Investigating drop in blended learning tags in 2023.
From CW: Could you do a quick tally of: a) how many schools in 2022 chose any of the child tags WITHOUT choosing “blended learning”
There were 21 instances where a school leader chose child tags but did not choose blended learning.
dat %>%
filter(year == 2022) %>%
filter(var %in% blended_tags) %>%
pivot_wider(names_from = "var",
values_from = "usage") %>%
group_by(school_id) %>%
mutate(children = case_when(
practices_a_la_carte == 1 ~ 1,
practices_flex == 1 ~ 1,
practices_flipped_classroom == 1 ~ 1,
practices_enriched_virtual == 1 ~ 1,
practices_station_rotation == 1 ~ 1,
TRUE ~ 0
),
childless = case_when(
practices_blended_learning == 1 & children == 0 ~ 1,
TRUE ~ 0
),
parentless = case_when(
practices_blended_learning == 0 & children == 1 ~ 1,
TRUE ~ 0
)) %>%
ungroup() %>%
summarize(selected_children = sum(parentless),
selected_parent_only = sum(childless)) %>%
datatable()- how many schools in 2023 chose “blended learning” as a parent tag but didn’t choose any child tags?
There were 53 instances where a school leader chose blended learning but did not choose one of the child tags. (And 94 instances where they did choose child tags, for comparison.)
dat %>%
filter(year == 2023) %>%
filter(var %in% blended_tags) %>%
pivot_wider(names_from = "var",
values_from = "usage") %>%
group_by(school_id) %>%
mutate(children = case_when(
practices_a_la_carte == 1 ~ 1,
practices_flex == 1 ~ 1,
practices_flipped_classroom == 1 ~ 1,
practices_enriched_virtual == 1 ~ 1,
practices_station_rotation == 1 ~ 1,
TRUE ~ 0
),
childless = case_when(
practices_blended_learning == 1 & children == 0 ~ 1,
TRUE ~ 0
)) %>%
ungroup() %>%
summarize(selected_parent = sum(childless),
selected_children = sum(children)) %>%
datatable()Models
#set up model function
tag_bayes <- function(data, id = "school_id", cov, threshold = NULL) {
mod_dat <- data %>%
select(id, cov, starts_with("practices")) %>%
pivot_longer(cols = starts_with("practices"), names_to = "tag", values_to = "value") %>%
na.omit()
if (!is.null(threshold)) {
mod_dat <- mod_dat %>% filter(value > threshold)
}
numeric_covs <- sapply(mod_dat[, cov], is.numeric) %>% names() %>% intersect(cov)
mod_dat <- mod_dat %>%
group_by(tag) %>%
mutate(across(all_of(numeric_covs), scale)) %>%
ungroup()
form <- as.formula(paste("value", "~", paste(cov, collapse = "+")))
bayes_mods <- unique(mod_dat$tag) %>%
setNames(nm = .) %>%
purrr::map(function(tag) stan_glm(
formula = form,
data = filter(mod_dat, tag == tag),
family = binomial(link = "logit"),
prior = student_t(df = 7, location = 0, scale = 2.5),
seed = 123
))
bayes_tidy <- bayes_mods %>%
purrr::map_dfr(tidy, .id = "tag") %>%
filter(term != "(Intercept)") %>%
mutate(
nice_tag = label_tags(tag),
nice_demog = factor(label_dems(term))
)
return(bayes_tidy)
}